home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / basic / ltsmenu.bas < prev    next >
BASIC Source File  |  1986-10-23  |  4KB  |  137 lines
  1. ' Lotus 123 type bar menu generator by Steve Trace CompuServe ID 70317,2124
  2.  
  3. ' This routine will provide a method to create 123 style menu for programs
  4. ' you develop.  The primary subprogram is barmenu.  The following parameters
  5. ' are required.
  6. ' y = the row you wish the first line of the menu to print on.
  7. '     values of 0 to 24 are valid.
  8. ' x = the column of the first menu prompt.  Values must be chosen carefully
  9. '     so your end of line with approiate spacing does not exceed your screen
  10. '     width.
  11. ' spacing = the number of spaces between each prompt.  Again values must be
  12. '     choosen carefully as in x above.
  13. ' tc = the foreground color for all prompts except the current option which
  14. '     will have this color as it's background color.
  15. ' bc = the background color except the current option which will have this
  16. '     color as the foreground.
  17. ' prompts$(2) = a two dimential array.  Since lbound and ubound functions
  18. '     are used within the subprogram any option base may be used.  However
  19. '     the second dimention may only have 2 values. (option base 0 value
  20. '     must be 1 - option base 1 value must be 2)
  21. '     (ie redim prompts$(anyvalue,1) for option base 0)
  22. '     assign the short prompt to the first subscript and a more descriptive
  23. '     string to the second subscript.  See example for ideas.
  24. ' return$ = the value returned upon exit from the subprogram.  This value
  25. '     could then be used to branch your program to other subprograms.
  26. '     The first character the first subscript of the selected prompts$ is
  27. '     returned in upper case.
  28. ' The left and right cursor keys can be used to move one selection at a time
  29. ' or the home and end keys can be used to go to the beginning or end of the
  30. ' menu.  Pressing enter will return the currently highlighted option.  You
  31. ' can also select an item by hitting the first character of any of the top
  32. ' row prompts.
  33.  
  34. ' $dynamic
  35.  
  36. defint a-z
  37.  
  38. ' sample program
  39.  
  40. dim menudata$(3,1)
  41.  
  42. menudata$(0,0) = "Go"               'create menu info
  43. menudata$(0,1) = "Run problem"
  44. menudata$(1,0) = "Previous"
  45. menudata$(1,1) = "Previous menu"
  46. menudata$(2,0) = "Next"
  47. menudata$(2,1) = "Next menu"
  48. menudata$(3,0) = "Quit"
  49. menudata$(3,1) = "Exit Program"
  50. width 80
  51. color 15,1,1
  52. cls
  53. call barmenu (24,5,5,14,1,menudata$(),option$)   ' call the menu
  54. cls
  55. if instr("GNP",option$) > 0 then    ' if Go, Next or Previous chosen do
  56.     redim menudata$(1,1)              ' create new menu info
  57.     menudata$(0,0) = "Go"
  58.     menudata$(0,1) = "Run problem"
  59.     menudata$(1,0) = "Previous"
  60.     menudata$(1,1) = "Previous menu"
  61.     call barmenu (4,5,5,12,1,menudata$(),option$)
  62. end if
  63. cls
  64. print option$;  ' just to show you what is returned
  65. end
  66.  
  67. ' meat of routine
  68.  
  69. def fnUpcase$(char$) = chr$(asc(char$) + (32 * (char$ => "a" and char$ <= "z")))
  70.  
  71. sub barmenu (y,x,spacing,tc,bc,prompts$(2),return$) static
  72.  
  73.     top = lbound(prompts$,1)
  74.     bottom = ubound(prompts$,1)
  75.     prompt = lbound(prompts$,2)
  76.     description = ubound(prompts$,2)
  77.     redim position(bottom)
  78.     okprompt$ = ""
  79.     locate y,x,0
  80.     color tc,bc
  81.     for i = top to bottom
  82.         position (i) = pos(y)
  83.         print prompts$(i,prompt); spc(spacing);
  84.         okprompt$ = okprompt$ + chr$(asc(prompts$(i,prompt)))
  85.     next i
  86.     current = top
  87.     moveto = current
  88.     return$ = ""
  89.     while return$ = ""
  90.        color bc,tc
  91.        locate y,position(current)
  92.        print prompts$(current,prompt);
  93.        locate y+1,x
  94.        color tc,bc
  95.        print prompts$(current,description);
  96.        while ch$ = ""
  97.           ch$ = inkey$
  98.        wend
  99.        if asc(ch$) = 0 then
  100.           call specialkey(ch$,moveto,top,bottom)
  101.        elseif ch$ = chr$(13) then
  102.           return$ = chr$(asc(prompts$(current,prompt)))
  103.        elseif instr(okprompt$,fnUpcase$(ch$)) > 0 then
  104.           return$ = fnUpcase$(ch$)
  105.        else
  106.           beep
  107.        end if
  108.        if moveto <> current then
  109.           locate y,position(current)
  110.           print prompts$(current,prompt);
  111.           locate y+1,x
  112.           print space$(80-x);
  113.           current = moveto
  114.        end if
  115.        ch$ = ""
  116.     wend
  117.     erase position
  118. end sub
  119.  
  120. sub specialkey(ch$,where,low,high) static
  121.  
  122.     c = asc(right$(ch$,1))
  123.     if c = 71 then
  124.         where = low
  125.     elseif c = 79 then
  126.         where = high
  127.     elseif c = 75 then
  128.         where = where -1
  129.     elseif c = 77 then
  130.         where = where + 1
  131.     else
  132.         beep
  133.     end if
  134.     if where < low then where = high
  135.     if where > high then where = low
  136. end sub
  137.